home *** CD-ROM | disk | FTP | other *** search
/ The Business Master (3rd Edition) / The Business Master (3rd Edition).iso / files / datature / pdevbas1 / utilprog.exe / DBUTIL02.SRC < prev    next >
Encoding:
Text File  |  1990-06-01  |  2.8 KB  |  31 lines
  1. |2010 CM$=CHR$(44):QM$=CHR$(34) 'Comma and Quote mark
  2. |2020 BLINKNORMAL%=|28:BLINKINSERT%=|29:BLINK2%=|30 'For CGA or EGA adapter, BLINKNORMAL%=6, BLINKINSERT%=4 and BLINK2%=7. For Monochrome adapter, BLINKNORMAL%=13, BLINKINSERT%=9 and BLINK2%=14.
  3. 2030 CLS
  4. 2040 LOCATE 1,16,0
  5. 2050 COLOR COLA%(2),COLA%(1)
  6. |2060 PRINT "PDS*BASE Data Base Clone Out Program |01";:COLOR COLA%(2),0
  7. 2070 PRINT:PRINT:COLOR COLA%(2),0:PRINT "This program will Clone Out all live records presently in the ";ZB$
  8. 2080 PRINT "Data Base file(s).  The Cloned Out ASCII file records will include all data":PRINT "base file pointers.  The Cloned Out file(s) can be Cloned In to the Re-Sized"
  9. 2090 PRINT "Data Base file(s).":PRINT:PRINT "The files will be created with the same names as the '.DAT' file(s) except":PRINT "that they will have '.PDS' as the file name extender.":PRINT:POSX%=CSRLIN+1
  10. 2100 FOR J=1 TO ZQ
  11. 2110 LOCATE POSX%,7,1:COLOR COLA%(2),0
  12. 2115 PRINT "Enter Clone-Out File Drive For ";ZS$(J,1);" (Enter=Skip) ";:POSY%=POS(0):COLOR 0,COLA%(3):PRINT " ";:COLOR COLA%(2),0:PRINT ":        ";:LOCATE POSX%,POSY%,1:D$="":WHILE D$="":D$=INKEY$:WEND:IF ASC(D$)=13 THEN D$=""
  13. 2120 IF D$="" OR D$=" " THEN BEEP:LOCATE 24,6,0:COLOR 15,0:PRINT "No Drive Letter entered - This file will be skipped - Strike any key";:COLOR 7,0:A$=INPUT$(1):LOCATE 24,1:PRINT SPC(79):LOCATE POSX+2,1:PRINT SPC(79):GOTO 2280
  14. 2130 COLOR 0,COLA%(3):PRINT D$;:COLOR 7,0:X=INSTR(ZS$(J,1),"."):F$=D$+":"+LEFT$(ZS$(J,1),X)+"PDS":OPEN F$ FOR OUTPUT AS #ZQ+1:LOCATE POSX%+3,32,0:PRINT "Read   W/Data";
  15. 2140 FOR ZR=1 TO ZS%(J,2)
  16. 2150 LOCATE POSX%+5,31:PRINT ZR;:ZA=J:ZZ=1:GOSUB 610 'read each record
  17. *28 2160 IF ZL$=STRING$(ZSIZE%(J,ZS%(J,10)),32) THEN GOTO 2250 ELSE LOCATE POSX%+5,39:PRINT ZR;"     ";
  18. *23 2160 IF ZS%(J,1)=1 THEN IF ZL$=STRING$(ZSIZE%(J,ZS%(J,10)),32) THEN GOTO 2250 ELSE LOCATE POSX%+5,39:PRINT ZR;"     ";:GOTO 2200
  19. *23 2170 SKIP%=1:FOR K=1 TO ZS%(J,7):IF Y$(K,J)<>STRING$(ZSIZE%(J,K),32) THEN SKIP%=0:K=ZS%(J,7)
  20. *23 2180 NEXT:IF SKIP%=1 THEN GOTO 2250 ELSE  LOCATE POSX%+5,39:PRINT ZR;"     ";
  21. *23 2190 PRINT #ZQ+1, ZR;CM$;QM$;ZB$(J);QM$;CM$;QM$;ZF$(J);CM$;:FOR K=1 TO ZS%(J,7)-1:PRINT #ZQ+1, QM$;Y$(K,J);QM$;CM$;:NEXT:PRINT #ZQ+1, QM$;Y$(ZS%(J,7),J);QM$:GOTO 2250
  22. *28 2200 FOR K=1 TO ZS%(J,7)-1:PRINT #ZQ+1, QM$;Y$(K,J);QM$;CM$;:NEXT:PRINT #ZQ+1, QM$;Y$(ZS%(J,7),J);QM$
  23. *23 2200 IF ZS%(J,4) > 0 THEN FOR K=1 TO ZS%(J,4):PRINT #ZQ+1, ZH$(J,K);CM$;ZE$(J,K);CM$;:NEXT
  24. *23 2230 FOR K=1 TO ZS%(J,7)-1:PRINT #ZQ+1, QM$;Y$(K,J);QM$;CM$;:NEXT:PRINT #ZQ+1, QM$;Y$(ZS%(J,7),J);QM$
  25. 2250 NEXT 'ZR
  26. 2260 CLOSE ZQ+1
  27. 2270 LOCATE 24,1,0:PRINT SPC(79):LOCATE 24,7:PRINT "All ";ZS$(J,1);" records Cloned Out - Strike any key to continue";:A$=INPUT$(1):LOCATE 24,1,0:PRINT SPC(79)
  28. 2280 NEXT J
  29. 2290 LOCATE 22,1:GOTO 400
  30. *31 Copyright 1987 by PRO DEV Software
  31.